home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / redakcyjne / programy / MediaMonkey 3.1.0.1256 / MediaMonkey_3.1.0.1256.exe / {app} / Scripts / Case.vbs < prev    next >
Text File  |  2008-02-11  |  17KB  |  467 lines
  1. ' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
  2. '
  3. '                "TitleCase.vbs", Jun-21-2005, v2.00
  4. '         VBScript for MediaMonkey 2.3.1 (or above), written by Risser
  5. '
  6. ' Purpose:
  7. ' - To update case on Artist, Album Artist, Album and Song Title fields.
  8. '
  9. ' Notes:
  10. ' - This script writes tags then immediately updates the DB.  There is no
  11. '   impact on the DB for tracks that are not part of the library (particularly, 
  12. '   the tracks are not auto-added to the library)
  13. ' - If you update an Artist name or an Album name, it updates the name in the 
  14. '   database and this change is reflected for all instances of that name, even 
  15. '   if it wasn't one of the selected tracks.
  16. ' - It's pretty smart about the location of punctuation, roman numerals, foreign contractions 
  17. '   (d', l', etc.), initials, cardinal numbers (1st, 40th), years (1950s, 1960's) and words with 
  18. '   no vowels, but it's not perfect.
  19. ' - There are also two pipe-separated (|) lists of words.  One is a "little" words list, like "the", 
  20. '   "an", "a", "of" etc.  If there's a word you'd like treated like a little word (maybe "on" or 
  21. '   "by", or other words if your tags aren't english), add it to the list.
  22. ' - The second list is a list of "forced-case" words.  If the parser sees this word in any case, it 
  23. '   replaces it with the word in the list, making it exactly that case.  This is good for acronyms 
  24. '   with vowels (BTO, REM, ELO; CCR and CSN have no vowels, so they are auto-uppercased), things that 
  25. '   need to stay lower case, or abbreviations with no vowels that should be uppercase, like Dr, Mr, 
  26. '   Mrs, St, etc.  Feel free to change these lists to match your collection.
  27. ' - It treats apostrophes as a letter, so these can be included in a word.  For example, for "James 
  28. '   Brown and the JB's", I have "JB's" and "JBs" in my forced case list.  
  29. ' - Also, on the forced case list, you can specify a final piece of punctuation.  Thus, I have "w/", 
  30. '   which will lowercase "w/", but leave "W" alone to be uppercase.  Also, I have "silence]" which 
  31. '   will force that configuration to be lowercase (for tracks that are all silence), but will treat 
  32. '   "Silence" normally.
  33. '
  34. ' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
  35.  
  36. Option Explicit
  37.  
  38. Dim littleWordString
  39. littleWordString = "a|an|and|at|de|del|di|du|e|el|en|et|for|from|la|le|in" & _
  40.            "|n|'n|n'|'n'|o'|'o'|of|or|por|the|to|un|une|und|with|y"
  41. Dim forceCapString
  42. forceCapString = "AC|EBN|OZN|MCs|MC's|DJs|DJ's|JBs|JB's|10cc|Mr|Mrs|Dr|Jr|Sr|Pt|St.|St"& _ 
  43.            "|vs|ft|feat|aka|vol|w/|ABC|ABCs|AC/|ASCII|ASCIII|ATV|BTO|ELO|ELP|EMI|DuShon" & _
  44.                "|FYC|INXS|MacArthur|OMC|OMD|OMPS|PSI|PTA|REM|REO|Sgt|UB40|UK|USA|USMC|UTFO|" & _
  45.                "silence]|T's|OK|USSR"
  46.  
  47. Dim res
  48. Dim alphaNum, whiteSpace, isMc, vowels, romanNumerals, cardinal, isForeignPref
  49. Set alphaNum = new regExp
  50. Set whiteSpace = new regExp
  51. Set isMc = new regExp
  52. Set vowels = new regExp
  53. Set romanNumerals = new RegExp
  54. Set cardinal = new RegExp
  55. Set isForeignPref = new RegExp
  56. alphaNum.ignoreCase = True
  57. alphaNum.pattern = "['`┤A-Za-z0-9" & ChrW(192) & "-" & ChrW(65276) & "]"
  58. whiteSpace.pattern = "^[\s,&]+$"  'include comma, ampersand, because we don't want to cap after these
  59. isMc.ignoreCase = True
  60. isMc.pattern = "^(O['`]|MC)"  ' handle O'Brien and McHenry
  61. isForeignPref.ignoreCase = True
  62. isForeignPref.pattern = "^([dl]|dell)['`]"  ' handle l', d' and dell'
  63. vowels.ignoreCase = True
  64. vowels.pattern = "[AEIOUY" & ChrW(192) & "-" & ChrW(601) & "]"
  65. romanNumerals.ignoreCase = True
  66. romanNumerals.pattern = "^M*(C(M|D)|D?C{0,3})(X(C|L)|L?X{0,3})(I(X|V)|V?I{0,3})$"
  67. cardinal.ignoreCase = True
  68. cardinal.pattern = "^\d*(1st|2nd|3rd|[0-9]th|[0-9]['`]?s)$" 'also handles years, like 1950s
  69. Dim littleWordList
  70. littleWordList = Split(littleWordString,"|")
  71. Dim forceCapList
  72. forceCapList = Split(forceCapString,"|")
  73. Public holdArtist, holdAlbum, holdTitle, holdAlbumArtist
  74. Set holdArtist = CreateObject("Scripting.Dictionary")
  75. Set holdAlbum = CreateObject("Scripting.Dictionary")
  76. Set holdTitle = CreateObject("Scripting.Dictionary")
  77. Set holdAlbumArtist = CreateObject("Scripting.Dictionary")
  78.  
  79. Const mmAnchorRight = 4
  80. Const mmAnchorBottom = 8
  81. Const mmAlignTop = 1
  82. Const mmAlignBottom = 2
  83. Const mmAlignClient = 5
  84. Const mmListDropdown = 2
  85. Const mmFormScreenCenter = 4
  86. Public styleOn
  87.  
  88. Function Style()
  89.   styleOn = Not styleOn
  90.   If styleOn Then
  91.     Style = ""
  92.   Else
  93.     Style = " class=""Dark"""
  94.   End If
  95. End Function
  96.  
  97. Function rdQS(UnquotedString)
  98.   rdQS = "'" & Replace(UnquotedString, "'", "''") & "'"
  99. End Function
  100.  
  101. Function uppercase(s)
  102.   If Left(s,1) = "'" And Len(s) > 1 Then
  103.     uppercase = Left(s,1)&UCase(Mid(s,2,1))&LCase(Mid(s,3))
  104.   Else
  105.     uppercase = UCase(Mid(s,1,1))&LCase(Mid(s,2))
  106.   End If
  107. End Function
  108.  
  109. Function fixUp(s, prevChars, nextChar)
  110.   Dim forceIndex, littleIndex, i
  111.   Dim capMe, allCaps, foreignPref
  112.   Dim upcased, littleUpped, forceUpped
  113.   forceIndex = -1
  114.   littleIndex = -1
  115.   capMe = false
  116.   allCaps = false
  117.   upcased = UCase(s)
  118.   foreignPref = isForeignPref.test(s)
  119.   
  120.   For i = 0 to UBound(forceCapList)
  121.     forceUpped = UCase(forceCapList(i))
  122.     If UCase(forceCapList(i)) = upcased Or forceUpped = upcased & nextChar Then
  123.       forceIndex = i
  124.       Exit For
  125.     End If
  126.   Next 'i
  127.   For i = 0 to UBound(littleWordList)
  128.     littleUpped = UCase(littleWordList(i))
  129.     If littleUpped = upcased Or littleUpped = upcased & nextChar Then
  130.       littleIndex = i
  131.       Exit For
  132.     End If
  133.   Next 'i
  134.   If forceIndex >= 0 Then
  135.     s = forceCapList(forceIndex)
  136.   Else
  137.     If Len(s) = 1 And nextChar = "." Then
  138.     ' if it's a single character followed by a period (an initial), caps it
  139.       allCaps = True
  140.     ElseIf Not vowels.test(s) And Not cardinal.test(s) Then
  141.     ' if it's all consonants, no vowels, and not a cardinal number, caps it
  142.       allCaps = True
  143.     ElseIf romanNumerals.test(s) And UCase(s) <> "MIX" And UCase(s) <> "MI" And UCase(s) <> "DI" Then
  144.     ' if it's roman numerals (and not 'mix' or 'di' which are valid roman numerals), caps it
  145.       allCaps = True
  146.     ElseIf prevChars = "" Or (nextChar = "" And Not foreignPref) Then
  147.     'if it's the first or last word, cap it
  148.       capMe = True
  149.     ElseIf Not whiteSpace.test(prevChars) Or (nextChar <> "" And InStr(")}]",nextChar)) Then
  150.     ' if it follows a punctuation mark (with or without spaces) or if it's before a close-bracket, cap it
  151.       capMe = True
  152.     ElseIf littleIndex < 0 And Not foreignPref Then
  153.     ' if it's not on the 'little word' list, cap it
  154.       capMe = True
  155.     End If
  156.     If allCaps Then
  157.       s = UCase(s)
  158.     ElseIf capMe Then
  159.       s = uppercase(s)
  160.     Else
  161.       s = LCase(s)
  162.     End If
  163.     If isMc.Test(s) And Len(s) > 2 Then
  164.     ' if it's Mc or O', cap the 3rd character (this assumes no names like McA)
  165.       s = Mid(s,1,2)&UCase(Mid(s,3,1))&LCase(Mid(s,4))
  166.     End If
  167.     If foreignPref Then
  168.     ' if it's l', d' or dell', lowercase the first letter and uppercase the first letter after the apostrophe
  169.       Dim pos
  170.       pos = InStr(s,"'")
  171.       If pos < 1 Then
  172.         pos = InStr(s,"`")
  173.       End If
  174.       If pos > 0 And pos < Len(s) Then
  175.         s = Mid(s,1,pos)&UCase(Mid(s,pos+1,1))&LCase(Mid(s,pos+2))
  176.       End If
  177.     End If
  178.   End If
  179.   fixUp = s
  180. End Function
  181.  
  182. Function updateCase(s)
  183.   Dim currentWord, result, fixed, theChar, lastNonWordChars
  184.   Dim forceIndex
  185.   Dim i
  186.   currentWord = ""
  187.   result = ""
  188.   lastNonWordChars = ""
  189.   
  190.   For i = 1 to Len(s)
  191.     theChar = Mid(s,i,1)
  192.     If alphaNum.test(theChar) Then
  193.       currentWord = currentWord & theChar
  194.     Else
  195.       If currentWord <> "" Then
  196.         fixed = fixUp(currentWord,lastNonWordChars,theChar)
  197.         If Right(fixed,1) = theChar Then 'handle stuff like w/
  198.           fixed = Left(fixed,Len(fixed)-1)
  199.           lastNonWordChars = ""
  200.         Else
  201.           lastNonWordChars = theChar
  202.         End If
  203.         result = result & fixed
  204.         currentWord = ""
  205.       Else
  206.         lastNonWordChars = lastNonWordChars & theChar
  207.       End If
  208.       result = result & theChar
  209.     End If
  210.   Next 'i
  211.   If Len(currentWord) > 0 Then
  212.     result = result & fixUp(currentWord,lastNonWordChars,"")
  213.   End If
  214.   updateCase = result
  215. End Function
  216.  
  217. Sub CloseDown
  218.   Set holdAlbum = nothing
  219.   Set holdAlbumArtist = nothing
  220.   Set holdArtist = nothing
  221.   Set holdTitle = nothing
  222.   SDB.Objects("CaseThingy") = Nothing
  223.   SDB.Objects("holdArtist") = Nothing
  224.   SDB.Objects("holdAlbumArtist") = Nothing
  225.   SDB.Objects("holdAlbum") = Nothing
  226.   SDB.Objects("holdTitle") = Nothing
  227. End Sub
  228.  
  229. Sub OnCancel(Btn)
  230.   CloseDown
  231. End Sub
  232.  
  233. Sub OnOK(Btn)
  234.   Set holdAlbum = SDB.Objects("holdAlbum")
  235.   Set holdAlbumArtist = SDB.Objects("holdAlbumArtist")
  236.   Set holdArtist = SDB.Objects("holdArtist")
  237.   Set holdTitle = SDB.Objects("holdTitle")
  238.  
  239.   Dim itm, str, sql
  240.   Dim items, albumNames, artistNames
  241.   Set items = CreateObject("Scripting.Dictionary")
  242.   Set albumNames = CreateObject("Scripting.Dictionary")
  243.   Set artistNames = CreateObject("Scripting.Dictionary")
  244.  
  245.   For Each itm In holdArtist
  246.     str = holdArtist.item(itm)
  247.     If Not items.exists(itm) Then
  248.       items.add itm, itm
  249.     End If
  250.     itm.artistName = str
  251.     If Not artistNames.exists(str) Then
  252.       sql = "UPDATE Artists SET Artist = " & rdQS(str) & " WHERE Artists.Artist= " & rdQS(Itm.ArtistName)
  253.       SDB.database.execSQL(sql)
  254.       ' This will affect ALL instances of this artist, including album artist, and on other tracks.
  255.       artistNames.add str, str
  256.     End If
  257.   Next 'itm
  258.   
  259.   For Each itm In holdAlbumArtist
  260.     str = holdAlbumArtist.item(itm)
  261.     If Not items.exists(itm) Then
  262.       items.add itm, itm
  263.     End If
  264.     itm.albumArtistName = str
  265.     If Not artistNames.exists(str) Then
  266.       sql = "UPDATE Artists SET Artist = " & rdQS(str) & " WHERE Artists.Artist= " & rdQS(Itm.albumArtistName)
  267.       SDB.database.execSQL(sql)
  268.       artistNames.add str, str
  269.     End If
  270.   Next 'itm
  271.   
  272.   For Each itm In holdAlbum
  273.     str = holdAlbum.item(itm)
  274.     If Not items.exists(itm) Then
  275.       items.add itm, itm
  276.     End If
  277.     itm.albumName = str
  278.     If Not albumNames.exists(str) Then
  279.       sql = "UPDATE Albums SET Album = " & rdQS(str) & " WHERE Albums.Album= " & rdQS(Itm.AlbumName)
  280.       SDB.database.execSQL(sql)
  281.       ' This will affect ALL instances of this album, including other tracks.
  282.       albumNames.add str, str
  283.     End If
  284.   Next 'itm
  285.   
  286.   For Each itm In holdTitle
  287.     str = holdTitle.item(itm)
  288.     If Not items.exists(itm) Then
  289.       items.add itm, itm
  290.     End If
  291.     itm.title = str
  292.   Next 'itm
  293.   
  294.   Dim list
  295.   Set list = SDB.NewSongList
  296.   For Each itm In items
  297.     list.Add( itm)
  298.   Next
  299.   
  300.   list.UpdateAll
  301.   
  302.   Set items = nothing
  303.   CloseDown
  304. End Sub
  305.  
  306. Function MapXML(original)
  307.   Dim hold
  308.   hold = Replace(original, "&", "&")
  309.   hold = Replace(hold, "  ", "  ")
  310.   hold = Replace(hold, "<", "<")
  311.   hold = Replace(hold, ">", ">")
  312.   hold = Replace(hold, """", """)
  313.   Dim i
  314.   i=1
  315.   While i<=Len(hold)
  316.     If (AscW(Mid(hold, i, 1))>127) Then
  317.       hold = Mid(hold, 1, i-1)+"&#"+CStr(AscW(Mid(hold, i, 1)))+";"+Mid(hold, i+1)
  318.     End If
  319.     i=i+1
  320.   WEnd
  321.   MapXML = hold
  322. End Function
  323.  
  324. Function MapField(fld)
  325.   If fld="" Then
  326.     MapField = " "
  327.   Else
  328.     MapField = MapXML(fld)
  329.   End If
  330. End Function
  331.  
  332. Function outField (fixed, normal)
  333.   If fixed = normal Then
  334.     outField = "<td>" & MapField(normal) & "</td>" & vbcrlf
  335.   Else
  336.     outField = "<td class=""highlight"" title=""" & SDB.Localize("Old Value: ") & Chr(13) & MapXML(normal) & """>" & MapField(fixed) & "</td>" & vbcrlf
  337.   End If
  338. End Function
  339.  
  340. Sub TitleCase
  341.   Dim UI, Form, Foot, Btn, Btn2, WB, HTML
  342.   
  343.   Dim trackList
  344.   Dim writeChanges
  345.   dim DlgWidth
  346.  
  347.   Set trackList = SDB.CurrentSongList
  348.  
  349.   If trackList.count=0 Then
  350.     res = SDB.MessageBox("Select tracks to be updated", mtError, Array(mbOk))
  351.     Exit Sub
  352.   End If
  353.  
  354.   Set UI = SDB.UI
  355.  
  356.   DlgWidth = 500
  357.  
  358.   ' Create the window to be shown
  359.   Set Form = UI.NewForm
  360.   Form.Common.SetRect 50, 50, DlgWidth, 400
  361.   Form.Common.MinWidth = 200
  362.   Form.Common.MinHeight = 150
  363.   Form.FormPosition = mmFormScreenCenter
  364.   Form.Caption = SDB.Localize("Case Checker")
  365.   Form.StayOnTop = True
  366.  
  367.   ' Create a web browser component
  368.   Set WB = UI.NewActiveX(Form, "Shell.Explorer")
  369.   WB.Common.Align = mmAlignClient      ' Fill all client rectangle
  370.   WB.Common.ControlName = "WB"
  371.  
  372.   ' Create a panel at the bottom of the window
  373.   Set Foot = UI.NewPanel(Form)
  374.   Foot.Common.Align = mmAlignBottom
  375.   Foot.Common.Height = 35
  376.  
  377.   ' Create a button that saves the report
  378.   Set Btn2 = UI.NewButton(Foot)
  379.   Btn2.Caption = SDB.Localize("OK")
  380.   Btn2.Common.SetRect DlgWidth - 205, 6, 85, 25
  381.   Btn2.Common.Anchors = mmAnchorRight + mmAnchorBottom
  382.   Btn2.UseScript = Script.ScriptPath
  383.   Btn2.OnClickFunc = "OnOK"
  384.   Btn2.Default = true
  385.  
  386.   ' Create a button that closes the window
  387.   Set Btn = UI.NewButton(Foot)
  388.   Btn.Caption = SDB.Localize("Cancel")
  389.   Btn.Common.SetRect DlgWidth - 105, 6, 85, 25
  390.   Btn.Common.Anchors = mmAnchorRight + mmAnchorBottom
  391.   Btn.UseScript = Script.ScriptPath
  392.   Btn.OnClickFunc = "OnCancel"
  393.   Btn.Cancel = true
  394.  
  395.   Form.SavePositionName = "CaseWindow"
  396.   Form.Common.Visible = True                ' Only show the form, don't wait for user input
  397.   SDB.Objects("CaseThingy") = Form  ' Save reference to the form somewhere, otherwise it would simply disappear
  398.  
  399.  
  400.   HTML = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & vbcrlf
  401.   HTML = HTML & "<html>" & vbcrlf
  402.   HTML = HTML & "  <head>" & vbcrlf
  403.   HTML = HTML & "    <title>" & SDB.Localize("Case Checker") & "</title>" & vbcrlf
  404.   HTML = HTML & "  </head>" & vbcrlf
  405.  
  406.   HTML = HTML & "<STYLE TYPE=text/css>" & vbcrlf
  407.   HTML = HTML & "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}" & vbcrlf
  408.   HTML = HTML & "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-align:left}" & vbcrlf
  409.   HTML = HTML & "P{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000;}" & vbcrlf
  410.   HTML = HTML & "TH{font-family:'Verdana',sans-serif; font-size:9pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}" & vbcrlf
  411.   HTML = HTML & "TD{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf
  412.   HTML = HTML & "TD.highlight{font-family:'Verdana',sans-serif; font-size:8pt; background-color:#FFFF77; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf
  413.   HTML = HTML & "TR.dark{background-color:#EEEEEE}" & vbcrlf
  414.   HTML = HTML & "TR.aleft TH{text-align:left}" & vbcrlf
  415.   HTML = HTML & "</STYLE>" & vbcrlf
  416.  
  417.   HTML = HTML & "  <body>" & vbcrlf
  418.   HTML = HTML & "    <H1>" & SDB.Localize("Recommended changes to capitalization:") & "</H1>" & vbcrlf
  419.   HTML = HTML & "    <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">" & vbcrlf
  420.   HTML = HTML & "      <tr class=""aleft"">" & vbcrlf
  421.   HTML = HTML & "        <th>" & SDB.Localize("Artist") & "</th>" & vbcrlf
  422.   HTML = HTML & "        <th>" & SDB.Localize("Title") & "</th>" & vbcrlf
  423.   HTML = HTML & "        <th>" & SDB.Localize("Album") & "</th>" & vbcrlf
  424.   HTML = HTML & "        <th>" & SDB.Localize("Album Artist") & "</th>" & vbcrlf
  425.   HTML = HTML & "      </tr>" & vbcrlf
  426.  
  427.   Dim i, itm
  428.   Dim artist, album, title, albumArtist
  429.   for i=0 to trackList.count-1
  430.     HTML = HTML & "      <tr" & Style() & ">" & vbcrlf
  431.  
  432.     Set itm = trackList.Item(i)
  433.     artist = updateCase(itm.artistName)
  434.     title = updateCase(itm.title)
  435.     album = updateCase(itm.albumName)
  436.     albumArtist = updateCase(itm.albumArtistName)
  437.     
  438.     HTML = HTML & outField(artist, itm.artistName)
  439.     HTML = HTML & outField(title, itm.title)
  440.     HTML = HTML & outField(album, itm.albumName)
  441.     HTML = HTML & outField(albumArtist, itm.albumArtistName)
  442.     If artist <> "" And artist <> itm.artistName Then
  443.       holdArtist.add itm, artist
  444.     End If
  445.     If albumArtist <> "" And albumArtist <> itm.albumArtistName Then
  446.       holdAlbumArtist.add itm, albumArtist
  447.     End If
  448.     If title <> "" And title <> itm.title Then
  449.       holdTitle.add itm, title
  450.     End If
  451.     If album <> "" And album <> itm.albumName Then
  452.       holdAlbum.add itm, album
  453.     End If
  454.     HTML = HTML & "      </tr>" & vbcrlf
  455.     
  456.   next 'i
  457.   
  458.   HTML = HTML & "    </table>" & vbcrlf
  459.   HTML = HTML & "  </body>" & vbcrlf
  460.   HTML = HTML & "</html>" & vbcrlf
  461.   WB.SetHTMLDocument( HTML)
  462.  
  463.   SDB.Objects("holdArtist") = holdArtist
  464.   SDB.Objects("holdAlbumArtist") = holdAlbumArtist
  465.   SDB.Objects("holdAlbum") = holdAlbum
  466.   SDB.Objects("holdTitle") = holdTitle
  467. End Sub